Delphi Informant Complete 1995 - 2000/Delphi Informant Complete 1995 to 2000.iso/Delphi Informant Magazine Complete Works SOURCE CODE 1998.rar/1998/Jul/di9807rl/moving.pas

Pascal/Delphi Source File | 1998-02-24 | 5KB | 183 lines

unit Moving;

{ Demostration of palettes and animation in a Delphi component.
  Copyright ⌐ 1998 Tempest Software, Inc.

  The TMovingGradient component displays a color gradient, with
  a user-specified starting and ending color, and number of
  color steps between them.

  When Enabled, the gradient continually rotates, which has the
  effect of moving sideways. Set Enabled to False to stop
  the animation effect. Palette animation works only on
  displays that use a palette, namely, 256-color video adapters.

  One possible use for this "non-progress" bar is to show that a
  process is running but you don't know when it will finish.
}

interface

uses
  SysUtils, Windows, Messages, Classes, Graphics, Controls, ExtCtrls, Gradient;

type
  TMovingGradient = class(TGradient)
  private
    // Timer for animating the palette
    fTimer: TTimer;

    procedure SetInterval(Value: Cardinal);
    function GetInterval: Cardinal;
    procedure CmEnabledChanged(var Msg: TWmNoParams); message Cm_EnabledChanged;
  protected
    procedure Animate(Sender: TObject); virtual;
    procedure GetColor(var Red, Green, Blue: Byte; Index: Integer); override;
    function MakePalette: HPalette; override;
    procedure ShiftColors; virtual;
  public
    constructor Create(Owner: TComponent); override;
  published
    property Enabled;
    property Height default 20;
    property ColorBottom default clWhite;
    property Interval: Cardinal read GetInterval write SetInterval default 100;
  end;

procedure Register;

implementation

// Create and initialize the control. Start with 64 steps
// because most palette devices use 18 bits per pixel,
// which means 6 bits per color, or 64 distinct colors.
// The colors blue and white look nice, but feel free to
// change them to whatever you find more aesthetic.
// Ditto for the default size.
constructor TMovingGradient.Create(Owner: TComponent);
begin
  inherited Create(Owner);

  fTimer := TTimer.Create(Self);
  fTimer.Enabled := not (csDesigning in ComponentState);
  fTimer.OnTimer := Animate;
  fTimer.Interval := 100;

  ColorBottom := clWhite;
  Height := 20;
end;

// Compute a color for the gradient.
procedure TMovingGradient.GetColor(var Red, Green, Blue: Byte; Index: Integer);
var
  Top, Bottom: TColor;
begin
  Top := ColorToRgb(ColorTop);
  Bottom := ColorToRgb(ColorBottom);
  if Index >= NumColors then
    Index := LogPalette.palNumEntries - Index - 1;

  Red   :=
    MulDiv(NumColors-Index-1, GetRValue(Top), NumColors-1) +
    MulDiv(Index, GetRValue(Bottom), NumColors-1);

  Green :=
    MulDiv(NumColors-Index-1, GetGValue(Top), NumColors-1) +
    MulDiv(Index, GetGValue(Bottom), NumColors-1);

  Blue  :=
    MulDiv(NumColors-Index-1, GetBValue(Top), NumColors-1) +
    MulDiv(Index, GetBValue(Bottom), NumColors-1);
end;

// Make a gradient palette and return the palette handle.
// Call this once when initializing the control.
// If the user changes the number of steps or the colors,
// recreate the palette with the new information.
function TMovingGradient.MakePalette: HPalette;
var
  I: Integer;
begin
  AllocatePalette(NumColors * 2);

  // To provide a smooth visual transition when rotating the palette,
  // make the gradient go up and down, so the gradient has twice as
  // many bands as it has distinct colors.

  {$R- Turn off range checking to access palette entries.}
  for I := 0 to LogPalette.palNumEntries-1 do
    with LogPalette.palPalEntry[I] do
    begin
      GetColor(peRed, peGreen, peBlue, I);
      if csDesigning in ComponentState then
        peFlags := 0
      else
        peFlags := PC_Reserved;
    end;
  {$R+}

  Result := CreatePalette(LogPalette^);
end;

// Shift the colors to animate the palette. Just rotate all the colors
// in the palette by one step.
procedure TMovingGradient.ShiftColors;
var
  Tmp: TPaletteEntry;
  I: Integer;
begin
  Assert(LogPalette <> nil);

{$R-}
  Tmp := LogPalette.palPalEntry[0];
  for I := 0 to LogPalette.palNumEntries-2 do
    LogPalette.palPalEntry[I] := LogPalette.palPalEntry[I+1];
  LogPalette.palPalEntry[LogPalette.palNumEntries-1] := Tmp;
{$R+}
end;

// Animate the control by shifting the colors and then telling
// Windows to use the new colors.
procedure TMovingGradient.Animate(Sender: TObject);
var
  OldPal: HPalette;
begin
  GetPalette; // Make sure the palette has been created.
  ShiftColors;

  OldPal := SelectPalette(Canvas.Handle, Palette, False);
  try
    AnimatePalette(Palette, 0, LogPalette.palNumEntries, @LogPalette.palPalEntry[0]);
  finally
    SelectPalette(Canvas.Handle, OldPal, False);
  end;
end;

// Propagate changes to the Enabled property to the timer, but
// at design time, leave the timer disabled.
procedure TMovingGradient.CmEnabledChanged(var Msg: TWmNoParams);
begin
  fTimer.Enabled := Enabled and not (csDesigning in ComponentState);
  inherited;
end;

// Propagate changes to the update interval to the timer.
procedure TMovingGradient.SetInterval(Value: Cardinal);
begin
  fTimer.Interval := Value
end;

// Get the interval from the timer.
function TMovingGradient.GetInterval: Cardinal;
begin
  Result := fTimer.Interval
end;


procedure Register;
begin
  RegisterComponents('Tempest', [TMovingGradient]);
end;

end.